home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / tix4.1 / SWidget.tcl < prev    next >
Encoding:
Text File  |  1998-12-04  |  10.5 KB  |  508 lines
  1. # SWidget.tcl --
  2. #
  3. #     tixScrolledWidget: virtual base class. Do not instantiate
  4. #    This is the core class for all scrolled widgets.
  5. #
  6. # Copyright (c) 1996, Expert Interface Technologies
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11.  
  12.  
  13. tixWidgetClass tixScrolledWidget {
  14.     -virtual true
  15.     -classname TixScrolledWidget
  16.     -superclass tixPrimitive
  17.     -method {
  18.     }
  19.     -flag {
  20.     -scrollbar -scrollbarspace
  21.     }
  22.     -configspec {
  23.     {-scrollbar scrollbar Scrollbar both}
  24.     {-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
  25.         {-sizebox sizeBox SizeBox 0}
  26.     }
  27. }
  28.  
  29. proc tixScrolledWidget:InitWidgetRec {w} {
  30.     upvar #0 $w data
  31.  
  32.     tixChainMethod $w InitWidgetRec
  33.  
  34.     set data(x,first)   0
  35.     set data(x,last)    0
  36.  
  37.     set data(y,first)   0
  38.     set data(y,last)    0
  39.  
  40.     set data(lastSpec) ""
  41.     set data(lastMW)   ""
  42.     set data(lastMH)   ""
  43.     set data(lastScbW) ""
  44.     set data(lastScbH) ""
  45.  
  46.     set data(repack)    0
  47.     set data(counter)   0
  48.  
  49.     set data(vsbPadY)   0
  50.     set data(hsbPadX)   0
  51. }
  52.  
  53. proc tixScrolledWidget:SetBindings {w} {
  54.     upvar #0 $w data
  55.  
  56.     tixChainMethod $w SetBindings
  57.  
  58.     tixManageGeometry $data(pw:client) "tixScrolledWidget:ClientGeomProc $w"
  59.     bind $data(pw:client) <Configure> \
  60.     [list tixScrolledWidget:ClientGeomProc $w "" $data(pw:client)]
  61.  
  62.     tixManageGeometry $data(w:hsb) "tixScrolledWidget:ClientGeomProc $w"
  63.     bind $data(w:hsb) <Configure> \
  64.     [list tixScrolledWidget:ClientGeomProc $w "" $data(w:hsb)]
  65.  
  66.     tixManageGeometry $data(w:vsb) "tixScrolledWidget:ClientGeomProc $w"
  67.     bind $data(w:vsb) <Configure> \
  68.     [list tixScrolledWidget:ClientGeomProc $w "" $data(w:vsb)]
  69.  
  70.     bind $w <Configure> "tixScrolledWidget:MasterGeomProc $w"
  71.  
  72.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  73.     set data(repack) 1
  74. }
  75.  
  76. proc tixScrolledWidget:config-scrollbar {w value} {
  77.     upvar #0 $w data
  78.     global tcl_platform
  79.  
  80.     if {[lindex $value 0] == "auto"} {
  81.     foreach xspec [lrange $value 1 end] {
  82.         case $xspec {
  83.         {+x -x +y -y} {}
  84.         default {
  85.             error "bad -scrollbar value \"$value\""
  86.         }
  87.         }
  88.     }
  89.     } else {
  90.     case $value in {
  91.         {none x y both} {}
  92.         default {
  93.         error "bad -scrollbar value \"$value\""
  94.         }
  95.     }
  96.     }
  97.  
  98.     if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  99.         set data(-scrollbar) both
  100.     }
  101.  
  102.     if {$data(repack) == 0} {
  103.     set data(repack) 1
  104.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  105.     }
  106. }    
  107.  
  108. proc tixScrolledWidget:config-scrollbarspace {w value} {
  109.     upvar #0 $w data
  110.   
  111.     if {$data(repack) == 0} {
  112.     set data(repack) 1
  113.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  114.     }
  115. }    
  116.  
  117. proc tixScrolledWidget:config-sizebox {w value} {
  118.   error "unimplemented"
  119. }
  120.  
  121.  
  122. #----------------------------------------------------------------------
  123. #
  124. #         Scrollbar calculations
  125. #
  126. #----------------------------------------------------------------------
  127. proc tixScrolledWidget:ClientGeomProc {w type client} {
  128.     upvar #0 $w data
  129.  
  130.     if {$data(repack) == 0} {
  131.     set data(repack) 1
  132.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  133.     }
  134. }
  135.  
  136. proc tixScrolledWidget:MasterGeomProc {w} {
  137.     upvar #0 $w data
  138.  
  139.     if {$data(repack) == 0} {
  140.     set data(repack) 1
  141.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  142.     }
  143. }
  144.  
  145. proc tixScrolledWidget:Configure {w} {
  146.     if {![winfo exists $w]} {
  147.     return
  148.     }
  149.  
  150.     upvar #0 $w data
  151.  
  152.     if {$data(repack) == 0} {
  153.     set data(repack) 1
  154.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  155.     }
  156. }
  157.  
  158. proc tixScrolledWidget:ScrollCmd {w scrollbar axis first last} {
  159.     upvar #0 $w data
  160.  
  161.     $scrollbar set $first $last
  162. }
  163.  
  164. # Show or hide the scrollbars as required.
  165. #
  166. # spec: 00 = need none
  167. # spec: 01 = need y
  168. # spec: 10 = need x
  169. # spec: 11 = need xy
  170. #
  171. proc tixScrolledWidget:Repack {w} {
  172.     tixCallMethod $w RepackHook
  173. }
  174.  
  175. proc tixScrolledWidget:RepackHook {w} {
  176.     upvar #0 $w data
  177.     global tcl_platform
  178.  
  179.     if {![winfo exists $w]} {
  180.     # This was generated by the <Destroy> event
  181.     #
  182.     return
  183.     }
  184.  
  185.     set client $data(pw:client)
  186.  
  187.     # Calculate the size of the master
  188.     #
  189.     set mreqw [winfo reqwidth  $w]
  190.     set mreqh [winfo reqheight $w]
  191.     set creqw [winfo reqwidth  $client]
  192.     set creqh [winfo reqheight $client]
  193.  
  194.     set scbW [winfo reqwidth  $w.vsb]
  195.     set scbH [winfo reqheight $w.hsb]
  196.  
  197.     case $data(-scrollbarspace) {
  198.     "x" {
  199.         incr creqh $scbH
  200.     }
  201.     "y" {
  202.         incr creqw $scbW
  203.     }
  204.     "both" {
  205.         incr creqw $scbW
  206.         incr creqh $scbH
  207.     }
  208.     }
  209.  
  210.     if {$data(-width) != 0} {
  211.     set creqw $data(-width)
  212.     }
  213.     if {$data(-height) != 0} {
  214.     set creqh $data(-height)
  215.     }
  216.  
  217.     if {$mreqw != $creqw || $mreqh != $creqh } {
  218.     if {![info exists data(counter)]} {
  219.         set data(counter) 0
  220.     }
  221.     if {$data(counter) < 50} {
  222.         incr data(counter)
  223.         tixGeometryRequest $w $creqw $creqh
  224.         tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  225.         set data(repack) 1
  226.         return
  227.     }
  228.     }
  229.  
  230.     set data(counter) 0
  231.     set mw [winfo width  $w]
  232.     set mh [winfo height $w]
  233.  
  234.     set cw [expr $mw - $scbW]
  235.     set ch [expr $mh - $scbH]
  236.  
  237.     set scbx [expr $mw - $scbW]
  238.     set scby [expr $mh - $scbH]
  239.  
  240.     # Check the validity of the sizes: if window was not mapped then
  241.     # sizes will be below 1x1
  242.     if {$cw < 1} {
  243.     set cw 1
  244.     }
  245.     if {$ch < 1} {
  246.     set ch 1
  247.     }
  248.     if {$scbx < 1} {
  249.     set scbx 1
  250.     }
  251.     if {$scby < 1} {
  252.     set scby 1
  253.     }
  254.  
  255.     if {[lindex $data(-scrollbar) 0] == "auto"} {
  256.     # Find out how we are going to pack the scrollbars
  257.     #
  258.     set spec [tixScrolledWidget:CheckScrollbars $w $scbW $scbH]
  259.  
  260.     foreach xspec [lrange $data(-scrollbar) 1 end] {
  261.         case $xspec {
  262.         +x {
  263.             set spec [expr $spec | 10]
  264.         }
  265.         -x {
  266.             set spec [expr $spec & 01]
  267.         }
  268.         +y {
  269.             set spec [expr $spec | 01]
  270.         }
  271.         -y {
  272.             set spec [expr $spec & 10]
  273.         }
  274.         }
  275.     }
  276.     if {$spec == 0} {
  277.         set spec 00
  278.     }
  279.     if {$spec == 1} {
  280.         set spec 01
  281.     }
  282.     } else {
  283.     case $data(-scrollbar) in {
  284.         none {
  285.         set spec 00
  286.         }
  287.         x {
  288.         set spec 10
  289.         }
  290.         y {
  291.         set spec 01
  292.         }
  293.         both {
  294.         set spec 11
  295.         }
  296.     }
  297.     }
  298.  
  299.  
  300.     if {$data(lastSpec)==$spec && $data(lastMW)==$mw && $data(lastMH)==$mh} {
  301.     if {$data(lastScbW) == $scbW && $data(lastScbH) == $scbH} {
  302.         tixCallMethod $w PlaceWindow
  303.         set data(repack) 0
  304.         return
  305.     }
  306.     }
  307.  
  308.     set vsbH [expr $mh - $data(vsbPadY)]
  309.     set hsbW [expr $mw - $data(hsbPadX)]
  310.  
  311.     if {$vsbH < 1} {
  312.     set vsbH 1
  313.     }
  314.     if {$hsbW < 1} {
  315.     set hsbW 1
  316.     }
  317.  
  318.     case $spec in {
  319.     "00" {
  320.         tixMoveResizeWindow $client 0 0 $mw $mh
  321.  
  322.         tixMapWindow $client
  323.             tixUnmapWindow $data(w:hsb)
  324.         tixUnmapWindow $data(w:vsb)
  325.     }
  326.     "01" {
  327.         tixMoveResizeWindow $client 0 0 $cw $mh
  328.         tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
  329.  
  330.         tixMapWindow $client
  331.         tixUnmapWindow $data(w:hsb)
  332.         tixMapWindow $data(w:vsb)
  333.     }
  334.     "10" {
  335.         tixMoveResizeWindow $client 0 0 $mw $ch
  336.         tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH 
  337.  
  338.         tixMapWindow $client
  339.         tixMapWindow $data(w:hsb)
  340.         tixUnmapWindow $data(w:vsb)
  341.     }
  342.     "11" {
  343.         set vsbH [expr $ch - $data(vsbPadY)]
  344.         set hsbW [expr $cw - $data(hsbPadX)]
  345.         if {$vsbH < 1} {
  346.         set vsbH 1
  347.         }
  348.         if {$hsbW < 1} {
  349.         set hsbW 1
  350.         }
  351.  
  352.         tixMoveResizeWindow $client 0 0 $cw $ch
  353.         tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
  354.         tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH 
  355.         if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  356.             tixMoveResizeWindow $data(w:sizebox) $scbx $scby $scbW $scbH
  357.         }
  358.  
  359.         tixMapWindow $client
  360.         tixMapWindow $data(w:hsb)
  361.         tixMapWindow $data(w:vsb)
  362.         if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  363.             tixMapWindow $data(w:sizebox)
  364.         }
  365.     }
  366.     }
  367.  
  368.     set data(lastSpec) $spec
  369.     set data(lastMW)   $mw
  370.     set data(lastMH)   $mh
  371.     set data(lastScbW) $scbW
  372.     set data(lastScbH) $scbH
  373.  
  374.     tixCallMethod $w PlaceWindow
  375.     set data(repack) 0
  376. }
  377.  
  378. proc tixScrolledWidget:PlaceWindow {w} {
  379.     # virtual base function
  380. }
  381.  
  382. #
  383. # Helper function
  384. #
  385. proc tixScrolledWidget:NeedScrollbar {w axis} {
  386.     upvar #0 $w data
  387.  
  388.     if {$data($axis,first) > 0.0} {
  389.     return 1
  390.     }
  391.  
  392.     if {$data($axis,last) < 1.0} {
  393.     return 1
  394.     }
  395.     
  396.     return 0
  397. }
  398.  
  399. # Return whether H and V needs scrollbars in a list of two booleans
  400. #
  401. #
  402. proc tixScrolledWidget:CheckScrollbars {w scbW scbH} {
  403.     upvar #0 $w data
  404.  
  405.     set mW [winfo width  $w]
  406.     set mH [winfo height $w]
  407.  
  408.     set info [tixCallMethod $w GeometryInfo $mW $mH]
  409.  
  410.     if {$info != ""} {
  411.     set xSpec [lindex $info 0]
  412.     set ySpec [lindex $info 1]
  413.  
  414.     set data(x,first)   [lindex $xSpec 0]
  415.     set data(x,last)    [lindex $xSpec 1]
  416.  
  417.     set data(y,first)   [lindex $ySpec 0]
  418.     set data(y,last)    [lindex $ySpec 1]
  419.     }
  420.  
  421.     set needX [tixScrolledWidget:NeedScrollbar $w x]
  422.     set needY [tixScrolledWidget:NeedScrollbar $w y]
  423.  
  424.     if {[winfo ismapped $w]==0} {
  425.     return "$needX$needY"
  426.     }
  427.  
  428.     if {$needX && $needY} {
  429.     return 11
  430.     }
  431.  
  432.     if {$needX == 0 && $needY == 0} {
  433.     return 00
  434.     }
  435.  
  436.     if {$needX} {
  437.     set mH [expr $mH - $scbH]
  438.     }
  439.     if {$needY} {
  440.     set mW [expr $mW - $scbW]
  441.     }
  442.  
  443.     set info [tixCallMethod $w GeometryInfo $mW $mH]
  444.     if {$info != ""} {
  445.     set xSpec [lindex $info 0]
  446.     set ySpec [lindex $info 1]
  447.  
  448.     set data(x,first)   [lindex $xSpec 0]
  449.     set data(x,last)    [lindex $xSpec 1]
  450.  
  451.     set data(y,first)   [lindex $ySpec 0]
  452.     set data(y,last)    [lindex $ySpec 1]
  453.     }
  454.  
  455.     set needX [tixScrolledWidget:NeedScrollbar $w x]
  456.     set needY [tixScrolledWidget:NeedScrollbar $w y]
  457.  
  458.     return "$needX$needY"
  459. }
  460.  
  461. #----------------------------------------------------------------------
  462. # Following is a bunch of crap. Not needed in TK 4.0.
  463. #----------------------------------------------------------------------
  464.  
  465. #----------------------------------------------------------------------
  466. # Keyboard events -
  467. #
  468. #    Raw event handlers: redirect binding events to class methods
  469. #
  470. proc tixScrolledWidget:RawUpKey {w} {
  471.     tixCallMethod $w HandleLineUp
  472. }
  473.  
  474. proc tixScrolledWidget:RawDownKey {w} {
  475.     tixCallMethod $w HandleLineDown
  476. }
  477.  
  478. proc tixScrolledWidget:RawLeftKey {w} {
  479.     tixCallMethod $w HandleLeftKey
  480. }
  481.  
  482. proc tixScrolledWidget:RawRightKey {w} {
  483.     tixCallMethod $w HandleRightKey
  484. }
  485.  
  486. proc tixScrolledWidget:RawPriorKey {w} {
  487.     tixCallMethod $w HandlePageUp
  488. }
  489.  
  490. proc tixScrolledWidget:RawNextKey {w} {
  491.     tixCallMethod $w HandlePageDown
  492. }
  493.  
  494. # Virtual event handlers: subclasses can derive from these functions
  495. #
  496.  
  497. proc tixScrolledWidget:HandleLineUp {w} {}
  498.  
  499. proc tixScrolledWidget:HandleLineDown {w} {}
  500.  
  501. proc tixScrolledWidget:HandlePageUp {w} {}
  502.  
  503. proc tixScrolledWidget:HandlePageDown {w} {}
  504.  
  505. proc tixScrolledWidget:HandleLeftKey {w} {}
  506.  
  507. proc tixScrolledWidget:HandleRightKey {w} {}
  508.